home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0029_Nice Graphics Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  13.1 KB  |  798 lines
  1. unit gru; { GRaphic Unit. }
  2. {$g+}
  3.  
  4. INTERFACE
  5.  
  6. type
  7.   palrec=record
  8.            r,g,b:byte;
  9.          end;
  10.   paltype=array[0..255]of palrec;
  11.   palptr=^paltype;
  12. const
  13.   vidseg:word=$a000;
  14.  
  15. procedure plot(const x,y:word;const c:byte);
  16. procedure plot2(const x,y,where:word;const c:byte);
  17. procedure setmode(const mode:word);
  18. procedure flip386(const a,b:word);
  19. procedure clear386(const where:word;const c:byte);
  20. procedure flip286(const a,b:word);
  21. procedure clear286(const where:word;const c:byte);
  22. procedure flip(const a,b:word);
  23. procedure clear(const where:word;const c:byte);
  24. procedure vret;
  25. procedure hline(const x1,x2,y:word;const c:byte);
  26. procedure hline2(const x1,x2,y,where:word;const c:byte);
  27. procedure vline(const x,y1,y2:word;const c:byte);
  28. procedure vline2(const x,y1,y2,where:word;const c:byte);
  29. procedure line(const x1,y1,x2,y2:word;const c:byte);
  30. procedure line2(const x1,y1,x2,y2,where:word;const c:byte);
  31. function  getpix(const x,y:word):byte;
  32. function  getpix2(const x,y,where:word):byte;
  33. function  rad(theta:real):real;
  34. procedure setpal(c,r,g,b:byte);
  35. procedure getvgapal(var pal:paltype);
  36. procedure setvgapal(var pal:paltype);
  37. procedure smooth(where:word);
  38. procedure smooth1(x,y,where:word);
  39. procedure smooth2(where,size:word);
  40. procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite);
  41. procedure fadefrompaltopal(oldpal,newpal:paltype);
  42. procedure ffblack(palin:paltype);
  43. procedure f2black(palin:paltype);
  44. procedure scanlines(numl:word);
  45. procedure combine(const in1,in2,out,eline:word);
  46.  
  47. var
  48.   clipon:boolean;
  49.   cx1,cx2,cy1,cy2:word;
  50.  
  51. IMPLEMENTATION
  52.  
  53. var
  54.   scrofs:array[0..199]of word; { Holding screen offsets. }
  55.   blackp:paltype;
  56.   whitep:paltype;
  57.   tempal:paltype;
  58.  
  59. procedure plot(const x,y:word;const c:byte); assembler;
  60. asm
  61.   cmp clipon,0
  62.   je @@sc
  63.   mov ax,[x]
  64.   cmp ax,cx1
  65.   jb @@exit
  66.   cmp ax,cx2
  67.   ja @@exit
  68.   mov ax,[y]
  69.   cmp ax,cy1
  70.   jb @@exit
  71.   cmp ax,cy2
  72.   ja @@exit
  73.   @@sc: { SkipCheck :-) }
  74.   mov es,sega000
  75.   mov bx,[y]
  76.   shl bx,1
  77.   mov di,word ptr[scrofs+bx]
  78.   add di,[x]
  79.   mov al,[c]
  80.   mov es:[di],al
  81. @@exit:
  82. end;
  83.  
  84. procedure plot2(const x,y,where:word;const c:byte); assembler;
  85. asm
  86.   cmp clipon,0
  87.   je @@sc
  88.   mov ax,[x]
  89.   cmp ax,cx1
  90.   jb @@exit
  91.   cmp ax,cx2
  92.   ja @@exit
  93.   mov ax,[y]
  94.   cmp ax,cy1
  95.   jb @@exit
  96.   cmp ax,cy2
  97.   ja @@exit
  98.   @@sc: { SkipCheck :-) }
  99.   mov ax,where
  100.   mov es,ax
  101.   mov bx,[y]
  102.   shl bx,1
  103.   mov di,word ptr[scrofs+bx]
  104.   add di,[x]
  105.   mov al,[c]
  106.   mov es:[di],al
  107. @@exit:
  108. end;
  109.  
  110. procedure setmode(const mode:word);assembler;
  111. asm
  112.   mov ax,mode
  113.   int 10h
  114. end;
  115.  
  116. procedure flip386(const a,b:word); assembler;
  117. asm
  118.   push ds
  119.   mov ds,a
  120.   mov es,b
  121.   xor si,si
  122.   xor di,di
  123.   mov cx,16000
  124.   db 66h; rep movsw
  125.   pop ds
  126. end;
  127.  
  128. procedure clear386(const where:word;const c:byte); assembler;
  129. asm
  130.   mov es,where
  131.   xor ax,ax
  132.   xor di,di
  133.   mov al,[c]
  134.   mov ah,al
  135.   db 66h; shr ax,16
  136.   mov al,[c]
  137.   mov ah,al
  138.   mov cx,16000
  139.   db 66h; rep stosw
  140. end;
  141.  
  142. procedure flip286(const a,b:word); assembler;
  143. asm
  144.   push ds
  145.   mov ds,a
  146.   mov es,b
  147.   xor si,si
  148.   xor di,di
  149.   mov cx,32000
  150.   rep movsw
  151.   pop ds
  152. end;
  153.  
  154. procedure clear286(const where:word;const c:byte); assembler;
  155. asm
  156.   mov es,where
  157.   xor ax,ax
  158.   xor di,di
  159.   mov al,[c]
  160.   mov ah,al
  161.   mov cx,32000
  162.   rep stosw
  163. end;
  164.  
  165. procedure flip(const a,b:word); assembler;
  166. asm
  167.   push ds
  168.   mov ds,a
  169.   mov es,b
  170.   xor si,si
  171.   xor di,di
  172.   mov cx,64000
  173.   rep movsb
  174.   pop ds
  175. end;
  176.  
  177. procedure clear(const where:word;const c:byte); assembler;
  178. asm
  179.   mov es,where
  180.   xor ax,ax
  181.   xor di,di
  182.   mov al,[c]
  183.   mov cx,64000
  184.   rep stosb
  185. end;
  186.  
  187. procedure vret; assembler;
  188. asm
  189.         mov dx,3dah;
  190. @vert1: in al,dx
  191.         test al,8
  192.         jz @vert1
  193. @vert2: in al,dx
  194.         test al,8
  195.         jnz @vert2
  196. end;
  197.  
  198. procedure hline(const x1,x2,y:word;const c:byte); assembler;
  199. asm
  200.   cld
  201.   mov es,sega000
  202.   mov ax,[x1]
  203.   mov cx,[x2]
  204.   sub cx,ax
  205.   mov di,[y]
  206.   mov bx,di
  207.   shl di,8
  208.   shl bx,6
  209.   add di,bx
  210.   add di,ax
  211.   mov al,[c]
  212.   mov ah,al
  213.   shr cx,1
  214.   rep stosw
  215.   adc cx,cx
  216.   rep stosb
  217. end;
  218.  
  219. procedure hline2(const x1,x2,y,where:word;const c:byte); assembler;
  220. asm
  221.   cld
  222.   mov ax,where
  223.   mov es,ax
  224.   mov ax,[x1]
  225.   mov cx,[x2]
  226.   sub cx,ax
  227.   mov di,[y]
  228.   mov bx,di
  229.   shl di,8
  230.   shl bx,6
  231.   add di,bx
  232.   add di,ax
  233.   mov al,[c]
  234.   mov ah,al
  235.   shr cx,1
  236.   rep stosw
  237.   adc cx,cx
  238.   rep stosb
  239. end;
  240.  
  241. procedure vline(const x,y1,y2:word;const c:byte);assembler;
  242. asm
  243.   mov es,sega000
  244.   mov ax,[y1]
  245.   mov bx,ax
  246.   shl ax,8
  247.   shl bx,6
  248.   add ax,bx
  249.   mov di,ax
  250.   mov ax,[y2]
  251.   mov bx,ax
  252.   shl ax,8
  253.   shl bx,6
  254.   add bx,ax
  255.   mov al,[c]
  256.   mov cx,[x]
  257.   add di,cx
  258.   add bx,cx
  259.  
  260.   @@loop1:
  261.     mov es:[di],al
  262.     add di,320
  263.     cmp di,bx
  264.     jne @@loop1
  265. end;
  266.  
  267. procedure vline2(const x,y1,y2,where:word;const c:byte);assembler;
  268. asm
  269.   mov ax,where
  270.   mov es,ax
  271.   mov ax,[y1]
  272.   mov bx,ax
  273.   shl ax,8
  274.   shl bx,6
  275.   add ax,bx
  276.   mov di,ax
  277.   mov ax,[y2]
  278.   mov bx,ax
  279.   shl ax,8
  280.   shl bx,6
  281.   add bx,ax
  282.   mov al,[c]
  283.   mov cx,[x]
  284.   add di,cx
  285.   add bx,cx
  286.  
  287.   @@loop1:
  288.     mov es:[di],al
  289.     add di,320
  290.     cmp di,bx
  291.     jne @@loop1
  292. end;
  293.  
  294. procedure line(const x1,y1,x2,y2:word;const c:byte);assembler;
  295. var
  296.   dex,dey,incf:Integer;
  297.   offset:word;
  298. asm
  299.   mov ax,[x2]
  300.   sub ax,[x1]
  301.   jnc @@dont1
  302.   neg ax
  303. @@dont1:
  304.   mov [dex],ax
  305.   mov ax,[y2]
  306.   sub ax,[y1]
  307.   jnc @@dont2
  308.   neg ax
  309. @@dont2:
  310.   mov [dey],ax
  311.   cmp ax,[dex]
  312.   jbe @@otherline
  313.   mov  ax,[y1]
  314.   cmp  ax,[y2]
  315.   jbe  @@dontswap1
  316.   mov  bx,[y2]
  317.   mov  [y1],bx
  318.   mov  [y2],ax
  319.   mov  ax,[x1]
  320.   mov  bx,[x2]
  321.   mov  [x1],bx
  322.   mov  [x2],ax
  323. @@dontswap1:
  324.   mov [incf],1
  325.   mov ax,[x1]
  326.   cmp ax,[x2]
  327.   jbe @@skipnegate1
  328.   neg [incf]
  329. @@skipnegate1:
  330.   mov di,[y1]
  331.   mov bx,di
  332.   shl di,8
  333.   shl bx,6
  334.   add di,bx
  335.   add di,[x1]
  336.   mov bx,[dey]
  337.   mov cx,bx
  338.   mov ax,$a000
  339.   mov es,ax
  340.   mov dl,[c]
  341.   mov si,[dex]
  342. @@drawloop1:
  343.   mov es:[di],dl
  344.   add di,320
  345.   sub bx,si
  346.   jnc @@goon1
  347.   add bx,[dey]
  348.   add di,[incf]
  349. @@goon1:
  350.   loop @@drawloop1
  351.   jmp  @@exitline
  352. @@otherline:
  353.   mov ax,[x1]
  354.   cmp ax,[x2]
  355.   jbe @@dontswap2
  356.   mov bx,[x2]
  357.   mov [x1],bx
  358.   mov [x2],ax
  359.   mov ax,[y1]
  360.   mov bx,[y2]
  361.   mov [y1],bx
  362.   mov [y2],ax
  363. @@dontswap2:
  364.   mov [incf],320
  365.   mov ax,[y1]
  366.   cmp ax,[y2]
  367.   jbe @@skipnegate2
  368.   neg [incf]
  369. @@skipnegate2:
  370.   mov di,[y1]
  371.   mov bx,di
  372.   shl di,8
  373.   shl bx,6
  374.   add di,bx
  375.   add di,[x1]
  376.   mov bx,[dex]
  377.   mov cx,bx
  378.   mov ax,$a000
  379.   mov es,ax
  380.   mov dl,[c]
  381.   mov si,[dey]
  382. @@drawloop2:
  383.   mov es:[di],dl
  384.   inc di
  385.   sub bx,si
  386.   jnc @@goon2
  387.   add bx,[dex]
  388.   add di,[incf]
  389. @@goon2:
  390.   loop @@drawloop2
  391. @@exitline:
  392. end;
  393.  
  394. procedure line2(const x1,y1,x2,y2,where:word;const c:byte);assembler;
  395. var
  396.   dex,dey,incf:Integer;
  397.   offset:word;
  398. asm
  399.   mov ax,[x2]
  400.   sub ax,[x1]
  401.   jnc @@dont1
  402.   neg ax
  403. @@dont1:
  404.   mov [dex],ax
  405.   mov ax,[y2]
  406.   sub ax,[y1]
  407.   jnc @@dont2
  408.   neg ax
  409. @@dont2:
  410.   mov [dey],ax
  411.   cmp ax,[dex]
  412.   jbe @@otherline
  413.   mov  ax,[y1]
  414.   cmp  ax,[y2]
  415.   jbe  @@DontSwap1
  416.   mov  bx,[y2]
  417.   mov  [y1],bx
  418.   mov  [y2],ax
  419.   mov  ax,[x1]
  420.   mov  bx,[x2]
  421.   mov  [x1],bx
  422.   mov  [x2],ax
  423. @@dontswap1:
  424.   mov [incf],1
  425.   mov ax,[x1]
  426.   cmp ax,[x2]
  427.   jbe @@skipnegate1
  428.   neg [incf]
  429. @@skipnegate1:
  430.   mov di,[y1]
  431.   mov bx,di
  432.   shl di,8
  433.   shl bx,6
  434.   add di,bx
  435.   add di,[x1]
  436.   mov bx,[dey]
  437.   mov cx,bx
  438.   mov ax,where
  439.   mov es,ax
  440.   mov dl,[c]
  441.   mov si,[dex]
  442. @@drawloop1:
  443.   mov es:[di],dl
  444.   add di,320
  445.   sub bx,si
  446.   jnc @@goon1
  447.   add bx,[dey]
  448.   add di,[incf]
  449. @@goon1:
  450.   loop @@drawloop1
  451.   jmp  @@exitline
  452. @@otherline:
  453.   mov ax,[x1]
  454.   cmp ax,[x2]
  455.   jbe @@dontswap2
  456.   mov bx,[x2]
  457.   mov [x1],bx
  458.   mov [x2],ax
  459.   mov ax,[y1]
  460.   mov bx,[y2]
  461.   mov [y1],bx
  462.   mov [y2],ax
  463. @@dontswap2:
  464.   mov [incf],320
  465.   mov ax,[y1]
  466.   cmp ax,[y2]
  467.   jbe @@skipnegate2
  468.   neg [incf]
  469. @@skipnegate2:
  470.   mov di,[y1]
  471.   mov bx,di
  472.   shl di,8
  473.   shl bx,6
  474.   add di,bx
  475.   add di,[x1]
  476.   mov bx,[dex]
  477.   mov cx,bx
  478.   mov ax,where
  479.   mov es,ax
  480.   mov dl,[c]
  481.   mov si,[dey]
  482. @@drawloop2:
  483.   mov es:[di],dl
  484.   inc di
  485.   sub bx,si
  486.   jnc @@goon2
  487.   add bx,[dex]
  488.   add di,[incf]
  489. @@goon2:
  490.   loop @@drawloop2
  491. @@exitline:
  492. end;
  493.  
  494. function getpix(const x,y:word):byte; assembler;
  495. asm
  496.   cmp clipon,0
  497.   je @@sc
  498.   mov ax,[x]
  499.   cmp ax,cx1
  500.   jb @@exit
  501.   cmp ax,cx2
  502.   ja @@exit
  503.   mov ax,[y]
  504.   cmp ax,cy1
  505.   jb @@exit
  506.   cmp ax,cy2
  507.   ja @@exit
  508.   @@sc: { SkipCheck :-) }
  509.   mov es,sega000
  510.   mov bx,[y]
  511.   shl bx,1
  512.   mov di,word ptr[scrofs+bx]
  513.   add di,[x]
  514.   mov al,es:[di]
  515. @@exit:
  516. end;
  517.  
  518. function getpix2(const x,y,where:word):byte; assembler;
  519. asm
  520.   cmp clipon,0
  521.   je @@sc
  522.   mov ax,[x]
  523.   cmp ax,cx1
  524.   jb @@exit
  525.   cmp ax,cx2
  526.   ja @@exit
  527.   mov ax,[y]
  528.   cmp ax,cy1
  529.   jb @@exit
  530.   cmp ax,cy2
  531.   ja @@exit
  532.   @@sc: { SkipCheck :-) }
  533.   mov ax,where
  534.   mov es,ax
  535.   mov bx,[y]
  536.   shl bx,1
  537.   mov di,word ptr[scrofs+bx]
  538.   add di,[x]
  539.   mov al,es:[di]
  540. @@exit:
  541. end;
  542.  
  543. function rad(theta:real):real;
  544. begin
  545.   rad:=theta*pi/180;
  546. end;
  547.  
  548. procedure setpal(c,r,g,b:byte); assembler;
  549. asm
  550.   mov dx,3c8h
  551.   mov al,[c]
  552.   out dx,al
  553.   inc dx
  554.   mov al,[r]
  555.   out dx,al
  556.   mov al,[g]
  557.   out dx,al
  558.   mov al,[b]
  559.   out dx,al
  560. end;
  561.  
  562. procedure getvgapal(var pal:paltype); assembler;
  563. asm
  564.   push ds
  565.   xor ax,ax
  566.   mov cx,0300h
  567.   les di,pal
  568.   mov dx,03c7h
  569.   out dx,al
  570.   inc dx
  571.   inc dx
  572.   cld
  573.   rep insb
  574.   pop ds
  575. end;
  576.  
  577. procedure setvgapal(var pal:paltype); assembler;
  578. asm
  579.   push ds
  580.   xor ax,ax
  581.   mov cx,0300h/2
  582.   lds si,pal
  583.   mov dx,03c8h
  584.   out dx,al
  585.   inc dx
  586.   mov bx,dx
  587.   cld
  588.   mov dx,03dah
  589.   @vsync0:
  590.     in al,dx
  591.     test al,8
  592.   jz @vsync0
  593.   mov dx,bx
  594.   rep outsb
  595.   mov bx,dx
  596.   mov dx,03dah
  597.   @vsync1:
  598.     in al,dx
  599.     test al,8
  600.   jz @vsync1
  601.   mov dx,bx
  602.   mov cx,0300h/2
  603.   rep outsb
  604.   pop ds
  605. end;
  606.  
  607. procedure smooth(where:word); assembler;
  608. asm
  609.   mov ax,where
  610.   mov es,ax
  611.   xor di,di
  612.   mov cx,64000-320
  613.   xor bh,bh
  614.   @@loop:
  615.     xor ax,ax
  616.     mov al,es:[di]
  617.     mov bl,es:[di+320] ;add ax,bx
  618.     mov bl,es:[di+1]   ;add ax,bx
  619.     mov bl,es:[di+321] ;add ax,bx
  620.     shr ax,2
  621.     mov es:[di],al
  622.     inc di
  623.     loop @@loop
  624. end;
  625.  
  626. procedure smooth1(x,y,where:word); assembler;
  627. asm
  628.   mov ax,where
  629.   mov es,ax
  630.   mov di,[y]
  631.   mov bx,di
  632.   shl di,8
  633.   shl bx,6
  634.   add di,bx
  635.   add di,[x]
  636.   xor bh,bh
  637.   xor ax,ax
  638.   mov al,es:[di]
  639.   mov bl,es:[di+320] ;add ax,bx
  640.   mov bl,es:[di+1]   ;add ax,bx
  641.   mov bl,es:[di+321] ;add ax,bx
  642.   shr ax,2
  643.   mov es:[di],al
  644. end;
  645.  
  646. procedure smooth2(where,size:word); assembler;
  647. asm
  648.   mov ax,where
  649.   mov es,ax
  650.   xor di,di
  651.   mov cx,size
  652.   xor bh,bh
  653.   @@loop:
  654.     xor ax,ax
  655.     mov al,es:[di]
  656.     mov bl,es:[di+320] ;add ax,bx
  657.     mov bl,es:[di+1]   ;add ax,bx
  658.     mov bl,es:[di+321] ;add ax,bx
  659.     shr ax,2
  660.     mov es:[di],al
  661.     inc di
  662.     loop @@loop
  663. end;
  664.  
  665. procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite); assembler;
  666. asm
  667.   push ds
  668.   lds si,[sprite]
  669.   mov ax,where
  670.   mov es,ax
  671.   cld
  672.   mov ax,[y]
  673.   shl ax,6
  674.   mov di,ax
  675.   shl ax,2
  676.   add di,ax
  677.   add di,[x]
  678.   mov bh,[h]
  679.   mov cx,320
  680.   sub cl,[w]
  681.   sbb ch,0
  682.  @l:
  683.   mov bl,[w]
  684.  @l2:
  685.   lodsb
  686.   cmp al,[c]
  687.   je @s
  688.   mov dl,[es:di]
  689.   add dl,al
  690.   mov es:[di],dl
  691.  @s:
  692.   inc di
  693.   dec bl
  694.   jnz @l2
  695.   add di,cx
  696.   dec bh
  697.   jnz @l
  698.   pop ds
  699. end;
  700.  
  701. procedure fadefrompaltopal(oldpal,newpal:paltype);
  702. var
  703.   dac,c:word;
  704. begin
  705.   for c:=32 downto 0 do
  706.   begin
  707.     for dac:=0 to 255 do
  708.     begin
  709.       tempal[dac].r:=((oldpal[dac].r*c)div 32)+((newpal[dac].r*(32-c))div 32);
  710.       tempal[dac].g:=((oldpal[dac].g*c)div 32)+((newpal[dac].g*(32-c))div 32);
  711.       tempal[dac].b:=((oldpal[dac].b*c)div 32)+((newpal[dac].b*(32-c))div 32);
  712.     end;
  713.     setvgapal(tempal);
  714.   end;
  715. end;
  716.  
  717. procedure ffblack(palin:paltype);
  718. var dac,i:word;
  719. begin
  720.   for i:=0 to 32 do
  721.   begin
  722.     for dac:=0 to 255 do
  723.     begin
  724.       tempal[dac].r:=(palin[dac].r*i)div 32;
  725.       tempal[dac].g:=(palin[dac].g*i)div 32;
  726.       tempal[dac].b:=(palin[dac].b*i)div 32;
  727.     end;
  728.     setvgapal(tempal);
  729.   end;
  730. end;
  731.  
  732. procedure f2black(palin:paltype);
  733. var
  734.   dac,i:word;
  735. begin
  736.   for i:=32 downto 0 do
  737.   begin
  738.     for dac:=0 to 255 do
  739.     begin
  740.       tempal[dac].r:=(palin[dac].r*i)div 32;
  741.       tempal[dac].g:=(palin[dac].g*i)div 32;
  742.       tempal[dac].b:=(palin[dac].b*i)div 32;
  743.     end;
  744.     setvgapal(tempal);
  745.   end;
  746. end;
  747.  
  748. procedure scanlines(numl:word); assembler;
  749. asm
  750.   mov dx, 3d4h
  751.   mov al, 9
  752.   out dx, al
  753.   inc dx
  754.   in al, dx
  755.   and al, 0E0h
  756.   add ax, numl
  757.   out dx, al
  758. end;
  759.  
  760. procedure combine(const in1,in2,out,eline:word); assembler;
  761. asm
  762.   push ds
  763.   mov ax,out; mov es,ax; xor di,di
  764.   cld
  765.   mov cx,[eline]
  766.   mov bx,cx
  767.   shl cx,8
  768.   shl bx,6
  769.   add cx,bx
  770.   mov bx,cx
  771.   shr cx,2
  772.   mov ax,in1; mov ds,ax; xor si,si
  773.   db 66h; rep movsw; adc cx,cx; rep movsw
  774.   mov ax,in2; mov ds,ax; mov si,bx
  775.   mov cx,64000
  776.   sub cx,bx
  777.   shr cx,2
  778.   db 66h; rep movsw; adc cx,cx; rep movsw
  779.   pop ds
  780. end;
  781.  
  782. var
  783.   count:word;
  784.  
  785. begin
  786.   clipon:=false;
  787.   cx1:=0; cx2:=319; cy1:=0; cy2:=199;
  788.   for count:=0 to 199 do scrofs[count]:=count*320; { Set up the offsets. }
  789.   for count:=0 to 255 do
  790.   begin
  791.     blackp[count].r:=0;
  792.     blackp[count].g:=0;
  793.     blackp[count].b:=0;
  794.     whitep[count].r:=63;
  795.     whitep[count].g:=63;
  796.     whitep[count].b:=63;
  797.   end;
  798. end.